home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / wheels2.arc / MKRMDIR.PAS < prev    next >
Pascal/Delphi Source File  |  1985-06-28  |  1KB  |  42 lines
  1. {@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
  2. The purchaser of these procedures and functions may include them in COMPILED
  3. programs freely, but may not sell or give away the source text.
  4.  
  5. }
  6. {$I regpack.typ}
  7. {$I filename.typ}
  8. {$I errmessg.lib}
  9. {$I mkrmdir.lib}
  10. {$I getkeys.lib}
  11. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  12. var
  13.   new_directory : filename_type;
  14.   error         : byte;
  15.   C, D          : char;
  16. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  17. begin
  18.   WriteLn('Enter a pathname for a new directory to create.');
  19.   WriteLn('Note that it must "grow" from an existing path.');
  20.   ReadLn(new_directory);
  21.   DoSubDirectory('M',new_directory,error);
  22.   if error <> 0 then
  23.     WriteLn(message(error))
  24.   else
  25.     begin
  26.       WriteLn('We have just created directory ',new_directory);
  27.       WriteLn('If you want to quit and confirm that fact, type Q.');
  28.       WriteLn('Otherwise, I will go on to remove ',new_directory);
  29.       GetKeys(C,D);
  30.       if UpCase(C) <> 'Q' then
  31.         begin
  32.           DoSubDirectory('R',new_directory,error);
  33.           if error <> 0 then
  34.             writeLn(message(error))
  35.           else
  36.             begin
  37.               WriteLn('Successfully removes ',new_directory);
  38.             end;
  39.         end;
  40.     end;
  41. end.
  42.